Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/w3dvb5/supernas.bas

BASIC Source File | 1997-12-22 | 21KB | 909 lines

Attribute VB_Name = "SUPERNAS1"
' Modulo per l'algoritmo del Pittore.
' Routine di entrata: Pittore


Type Vec_Int
   x As Integer
   Y As Integer
End Type

Type Vertex
   x As Integer
   Y As Integer
   Z As Integer
   Used As Integer
End Type
Public v() As Vertex


Type triadata
   Normal As Vec3
   h As Single
   Color As Integer
End Type


Type Tria
    Anr As Integer
    Bnr As Integer
    Cnr As Integer
    Z As Integer
    PTria As triadata ' Valore Triadata
End Type

Public Triangles() As Tria
Public Ptriangles As Integer

Type TriaNode
    trnr As Integer
    NextNodo As Integer
End Type


Public Const LARGE = 32000 ' // Non maggiore di sqrt(LONG_MAX)
Public Const LARGE1 = 32001 ' Usato solo da LineaNas
Public Const PIdiv180 = 0.0174532
Public Const BIG = 1E+30

Public X__max As Integer ' Coordinate reali della finestra
Public Y__max As Integer ' Coordinate reali della finestra

Public f As Double
Public zfactor As Double
Public rcolormin As Double
Public rcolormax As Double
Public delta As Double
Public zemin As Double
Public zemax As Double
Public xsC As Double
Public ysC As Double
Public XLCreal As Double
Public YLCreal As Double

Public kEye As Integer
Public hK As Integer
Public XLC As Integer
Public YLC As Integer


Public Vt() As Vec3
Public lightvector As Vec3



Public TriaNodeNext() As TriaNode

Public PStart As Integer
Public PEnd As Integer


Sub Complete_Triangles(n As Integer, offset As Integer, nrs_tr() As Trianrs)

'// Completa triangles[offset],..., triangles[offset+n-1].
'// Numeri di vertice: nrs_tr[0],..., nrs_tr[n-1].
'// Questi triangoli appartengono allo stesso poligono. L'equazione
'// del loro piano Φ nx . x + ny . y + nz . z = h.


  Dim i As Integer
  Dim Anr As Integer
  Dim Bnr As Integer
  Dim Cnr As Integer
  Dim ZA As Integer
  Dim ZB As Integer
  Dim ZC As Integer
  Dim zmin As Single
  Dim zmax As Single

  Dim nx As Double
  Dim ny As Double
  Dim nz As Double
  Dim ux As Double
  Dim uy As Double
  Dim uz As Double
  Dim vx As Double
  Dim vy As Double
  Dim vz As Double
  Dim factor As Double
  Dim h As Double
  Dim Ax As Double
  Dim Ay As Double
  Dim Az As Double
  Dim Bx As Double
  Dim By As Double
  Dim Bz As Double
  Dim Cx As Double
  Dim Cy As Double
  Dim Cz As Double

  Dim p As Integer
  Dim q As triadata

'   // Se il poligono Φ un'approssimazione di una circonferenza, i
'   // primi tre vertici possono giacere quasi sulla stessa linea,
'   // da cui n/2 invece di 0 nell'istruzione for che segue:

  For i = n \ 2 To n
     Anr = nrs_tr(i).a
     Bnr = nrs_tr(i).b
     Cnr = nrs_tr(i).C
     If (orienta(Anr, Bnr, Cnr) > 0) Then Exit For
   Next

   ZA = v(Anr).Z
   ZB = v(Bnr).Z
   ZC = v(Cnr).Z

   Az = zEye(ZA)
   Bz = zEye(ZB)
   Cz = zEye(ZC)
   Ax = xScreen(v(Anr).x) * Az
   Ay = yScreen(v(Anr).Y) * Az
   Bx = xScreen(v(Bnr).x) * Bz
   By = yScreen(v(Bnr).Y) * Bz
   Cx = xScreen(v(Cnr).x) * Cz
   Cy = yScreen(v(Cnr).Y) * Cz
   ux = Bx - Ax
   uy = By - Ay
   uz = Bz - Az
   vx = Cx - Ax
   vy = Cy - Ay
   vz = Cz - Az
   nx = uy * vz - uz * vy
   ny = uz * vx - ux * vz
   nz = ux * vy - uy * vx
   h = nx * Ax + ny * Ay + nz * Az
   factor = 1 / Sqr(nx * nx + ny * ny + nz * nz)
   q.Normal.x = nx * factor
   q.Normal.Y = ny * factor
   q.Normal.Z = nz * factor
   q.h = h * factor
   For i = 0 To n - 1
      p = offset + i
      Triangles(p).Anr = nrs_tr(i).a
      Triangles(p).Bnr = nrs_tr(i).b
      Triangles(p).Cnr = nrs_tr(i).C
      Triangles(p).PTria = q
   '   // Sceglie il lato del triangolo per cui Z varia maggiormente;
   '   // Triangles(p).Z si baserα sul punto medio di questo lato:
      zmin = v(Triangles(p).Anr).Z
      zmax = zmin
      ZB = v(Triangles(p).Bnr).Z
      ZC = v(Triangles(p).Cnr).Z
      If (ZB < zmin) Then
         zmin = ZB
      ElseIf (ZB > zmax) Then
         zmax = ZB
      End If
      If (ZC < zmin) Then
         zmin = ZC
      ElseIf (ZC > zmax) Then
         zmax = ZC
      End If
      Triangles(p).Z = (zmin + zmax) / 2

   Next

End Sub

Sub DeleteList(Start() As TriaNode)

   Dim p As TriaNode
'   Do While (Start <> Null)
'     p = start;
'     start = start->next;

End Sub

Function Distance(ITria As Integer, x As Integer, Y As Integer) As Double


'// Si considera la linea passante per il punto di osservazione E
'// e il punto (X, Y) del video. Interessa il punto in cui questa
'// linea interseca il triangolo itria. Sarα restituita la
'// coordinata ze di questo punto.

  Static Dist0 As Double
  Static X0 As Integer
  Static Y0 As Integer
  Static PTria0 As Integer

  Dim a As Double
  Dim b As Double
  Dim C As Double
  Dim h As Double
  Dim xs As Double
  Dim ys As Double

'  Dist0 = 0: X0 = 0: Y0 = 0

 ' // Variabili statiche, qualora lo stesso punto (X, Y) sia usato
 ' // per due triangoli consecutivi appartenenti allo stesso
 ' // poligono (e quindi con lo stesso puntatore ptria).

  Dim TriaPtr As Integer
  Dim PTria As Integer

  TriaPtr = ITria
'  PTria = Triangles(TriaPtr).PTria

 '  tria huge* triaptr = triangles + itria; // = &triangles[itria]
 '  triadata huge*ptria=triaptr->ptria;

   If (PTria0 <> TriaPtr Or x <> X0 Or Y <> Y0) Then
      a = Triangles(TriaPtr).PTria.Normal.x
      b = Triangles(TriaPtr).PTria.Normal.Y
      C = Triangles(TriaPtr).PTria.Normal.Z
      h = Triangles(TriaPtr).PTria.h
      xs = xScreen(x)
      ys = yScreen(Y)
      Dist0 = h * Sqr(xs * xs + ys * ys + 1) / (a * xs + b * ys + C)
      X0 = x
      Y0 = Y
      PTria0 = TriaPtr
   End If

   Distance = Dist0

End Function



Sub DrawWireFrame(Pic As PictureBox)

Dim i As Integer, k As Integer, j As Integer

For k = 1 To UBound(FileVertex)
 i = Abs(FileVertex(k).Vert(1))
 If i > 0 Then
    Xl = to_pix(v(i).x)
    Yl = to_pix(v(i).Y)
    x1 = Xl
    y1 = Yl
    For j = 1 To FileVertex(k).Count
        i = FileVertex(k).Vert(j)
        If i > 0 Then
           x = to_pix(v(i).x)
           Y = to_pix(v(i).Y)
           Pic.Line (x1, y1)-(x, Y)
           x1 = x: y1 = Y
        End If
    Next j
 End If

Next


End Sub

Sub Fill_Triangle(Pic As PictureBox, i As Integer)

' // Riempie il triangolo i

 Dim Triangle(2) As CornerRec
 Dim Anr As Integer
 Dim Bnr As Integer
 Dim Cnr As Integer

 Anr = Triangles(i).Anr
 Bnr = Triangles(i).Bnr
 Cnr = Triangles(i).Cnr

 Triangle(0).x = to_pix(v(Anr).x)
 Triangle(0).Y = to_pix(v(Anr).Y)

 Triangle(1).x = to_pix(v(Bnr).x)
 Triangle(1).Y = to_pix(v(Bnr).Y)

 Triangle(2).x = to_pix(v(Cnr).x)
 Triangle(2).Y = to_pix(v(Cnr).Y)

 Shade% = Triangles(i).PTria.Color

 Call DrawTriangle(Pic, Triangle(), Shade%)

End Sub

Sub FindRange(i As Integer)
   Dim Normal As Vec3
   Normal.x = Triangles(i).PTria.Normal.x
   Normal.Y = Triangles(i).PTria.Normal.Y
   Normal.Z = Triangles(i).PTria.Normal.Z
   Dim rcolor As Single
   rcolor = DotProduct(Normal, lightvector)
   If (rcolor < rcolormin) Then rcolormin = rcolor
   If (rcolor > rcolormax) Then rcolormax = rcolor
End Sub


Function Inside_Triangle(x As Integer, Y As Integer, XA As Integer, YA As Integer, XB As Integer, YB As Integer, xC As Integer, yC As Integer) As Integer


'  // (X, Y) giace sopra o dentro il triangolo ABC?

 Inside_Triangle = Orientation(XB - XA, YB - YA, x - XA, Y - YA) >= 0 And _
                  Orientation(xC - XB, yC - YB, x - XB, Y - YB) >= 0 And _
                  Orientation(XA - xC, YA - yC, x - xC, Y - yC) >= 0

End Function


Function Int_To_Pix(x As Double)
  Int_To_Pix = (x + hK) / k
End Function

Function IntersectOrizontal(a As Vec_Int, b As Vec_Int, Y As Integer, xxMin As Integer, xxmax As Integer) As Integer


' // Il segmento AB ha dei punti in comune con il
' // segmento orizzontale {(Xmin, Y), (Xmax, Y)}?


Dim XA As Integer
Dim YA As Integer
Dim XB As Integer
Dim YB As Integer
Dim dx As Long
Dim dy As Long
Dim yDx As Long